#!/usr/bin/perl -wc

package RFCMail::DNS::AsyncResolve;

use strict;
use warnings;
use base qw(Exporter);
use RFCMail::DNS::Snapshot;
use RFCMail::Util::Callback qw(callback);
use RFCMail::DNS::AsyncQuery qw(async_dns_query);


BEGIN {
    our @EXPORT_OK = qw(async_resolve);
}

INIT {
    our %INDIRECT_A =
	(
	 MX => 'exchange',
	 NS => 'nsdname',
	 SRV => 'target',
	 );
}


sub async_resolve {
    my ($callback, $domain, $type, $snapshot) = @_;
    new($callback, $snapshot)->query($type, $domain);
}


# From this point on, it's internal methods

# generates an object on which to operate
sub new {
    my ($callback, $snapshot) = @_;
    $snapshot ||= RFCMail::DNS::Snapshot->new();
    return (bless [ $callback, $snapshot, 0 ]);
}


# method for accessing the snapshot sub-object (our cache)
sub snapshot { $_[0]->[1] }


# methods start() and finish() are a semaphore-like construct
# the callback is invoked by finish() if it has been called as often as start()
# this weirdness arises from the need to track async subroutine calls
sub start { ++$_[0]->[2] }
sub finish { --$_[0]->[2] or callback($_[0]->[0], $_[0]->[1]) }


# method for performing DNS queries, with recursion and cache-awareness
sub query {
    my $self = shift;
    my $type = shift;
    $self->start;
    for (@_) {
	next if $self->snapshot->have_answer($_, $type);
	$self->start;
	async_dns_query(sub { $self->handle_result(@_, $type) }, $_, $type);
    }
    $self->finish;
}


# callback method for handling query results
sub handle_result {
    my ($self, $result, $type) = @_;
    our (%INDIRECT_A);
    if (defined($result)) {
	$self->snapshot->add_response($result);
	# CNAME processing
	$self->cname_processing($result, $type)
	    if $type ne 'CNAME' and $type ne 'ANY';
	# 'A' additional processing
	my $method = $INDIRECT_A{$type};
	$self->additional_processing($result, $type, $method, 'A')
	    if defined($method);
    }
    $self->finish;
}


# method for making additional same-type queries due to CNAMEs in answer
sub cname_processing {
    my ($self, $result, $type) = @_;
    my @names = map($_->type eq 'CNAME' ? $_->cname : (), $result->answer);
    $self->query($type, @names);
}


# method for making additional new-type queries due to non-terminal results
sub additional_processing {
    my ($self, $result, $type, $method, $newtype) = @_;
    my @names;
    for ($result->answer) {
	next if $_->type ne $type;
	my $name = $_->$method;
	next if $name eq '.';
	push @names, $name;
    }
    $self->query($newtype, @names)
	if @names;
}


1;
